(in-package #:lilu-emacs)

;;;
;;; emacs
;;;

(defun build-emacs-options (application &key loadfile eval theme server-name)
  (declare (ignore application))
  (let ((options `(,@(when loadfile (list "--load" loadfile))
                   ,@(when eval (list "--eval" eval))
                   ,@(when theme
                       (list "--eval" (format nil "(load-theme '~A t)"
                                              (if (symbolp theme)
                                                  (string-downcase (symbol-name theme))
                                                  theme))))
                   ,@(if server-name
                         (list "--name" server-name
                               "--eval"
                               (format nil "(progn (setq server-name \"~A\") (server-start))" server-name)))
                   )))
    options))

(defclass emacs-application (lilu-app:simple-program-application-mixin
                             lilu-app:application)
  ()
  (:default-initargs
   :name (string :emacs)
   :program "emacs"
   :version-option "--version"
   :version-script "emacs --version | head -1 | awk -F ' ' '{ print $3 }'"
   :tags '(:terminal :browser :repl :editor :debugger :inspector)
   :make-args-fn #'build-emacs-options))

(lilu-app:register-application (make-instance 'emacs-application))

(defvar *emacs-program* (lilu-app:find-application :emacs))

(defun run-emacs-program (&rest args &key loadfile eval theme server-name
                                       (wait-p t) (error-p t))
  (declare (ignore loadfile eval theme server-name wait-p error-p))
  (apply #'lilu-app:run-simple-program *emacs-program*
         args))

;;;
;;; emacsclient
;;;

(defun build-emacsclient-options (application &key file line-no expression
                                                create-frame-p (wait-closed-p t)
                                                (server-name *default-emacs-server-name*))
  (declare (ignore application))
  (assert (or file expression))
  (let ((options `(,@(when create-frame-p
                       '("--create-frame"))
                   ,@(unless wait-closed-p
                       '("--no-wait"))
                   ,(format nil "--socket-name=~A" server-name)
                   ,@(when expression
                       `("--eval" ,(format nil "~A" expression)))
                   ,@(when line-no (list (format nil "+~A" line-no)))
                   ,@(when file
                       `(,(format nil "~A" (namestring file)))))))
    options))

(defclass emacsclient-application (lilu-app:simple-program-application-mixin
                                   lilu-app:application)
  ()
  (:default-initargs
   :name (string :emacsclient)
   :program "emacsclient"
   :version-option "--version"
   :version-script "emacsclient --version | awk -F ' ' '{ print $2 }'"
   :tags '()
   :make-args-fn #'build-emacsclient-options))

(defvar *emacsclient-program* (lilu-app:register-application (make-instance 'emacsclient-application)))

(defun run-emacsclient-program (&rest args &key file line-no expression create-frame-p
                                             (wait-closed-p t) (server-name *default-emacs-server-name*)
                                             (error-p t) (wait-p t))
  (declare (ignore file line-no expression create-frame-p wait-closed-p server-name error-p wait-p))
  (apply #'lilu-app:run-simple-program *emacsclient-program*
         args))

;;;
;;; server
;;;

(defparameter *default-emacs-theme* 'deeper-blue)
(defparameter *default-emacs-server-name* "lilu")

(defun open-emacs (&key
                     (server-name *default-emacs-server-name*)
                     (theme *default-emacs-theme*)
                     (wait-p nil)
                     (error-p t)
                     (ignore-already-open-p nil))
  (let ((alive-p (emacs-open-p :server-name server-name)))
    (when (and alive-p (not ignore-already-open-p))
      (if error-p
          (error (format nil "emacs server (~A) is already running." server-name))
          (warn (format nil "emacs server (~A) is already running." server-name))))
    (if alive-p
        :already-running
        (flet ((run-program ()
                 (run-emacs-program
                  :loadfile (namestring (get-local-emacs-file "emacs-server.el"))
                  :server-name server-name
                  :theme theme
                  :wait-p wait-p
                  :error-p error-p)))
          (multiple-value-bind (msg ret)
              (run-program)
            (unless wait-p
              (emacs-open-p :server-name server-name :retries 20 :sleep 0.25 :error-p t))
            (if ret
                (values msg)
                (values nil msg)))))))

;;;
;;; client
;;;

(defun emacs-edit (pathname &key
                              (line-no nil)
                              (server-name *default-emacs-server-name*)
                              (create-frame-p nil)
                              (wait-closed-p t)
                              (wait-p t)
                              (error-p t)
                              (ensure-server-p t))
  (unless (if ensure-server-p
              (open-emacs :server-name server-name :wait-p nil :error-p error-p :ignore-already-open-p t)
              (emacs-open-p :server-name server-name :error-p error-p))
    (warn "emacs server (name: ~A) is not running" server-name)
    (return-from emacs-edit nil))
  (flet ((run-program ()
           (run-emacsclient-program
            :file pathname
            :line-no line-no
            :server-name server-name
            :create-frame-p create-frame-p
            :wait-closed-p wait-closed-p
            :wait-p (or wait-p wait-closed-p)
            :error-p error-p)))
    (progn
      (multiple-value-bind (msg ret)
          (run-program)
        (if ret
            (values (or msg t))
            (progn
              (unless error-p
                (warn "~A" msg))
              (values nil msg)))))))

(defun emacs-eval (expression &key
                                (server-name *default-emacs-server-name*)
                                (wait-p t)
                                (error-p t)
                                (ensure-server-p t)
                                (verify-server-p t)
                                (quiet-p nil))
  (when verify-server-p
    (unless (if ensure-server-p
                (open-emacs :server-name server-name :wait-p nil :error-p error-p :ignore-already-open-p t)
                (emacs-open-p :server-name server-name :error-p error-p))
      (warn "emacs server (name: ~A) is not running" server-name)
      (return-from emacs-eval nil)))
  (flet ((run-program ()
           (run-emacsclient-program
            :expression expression
            :server-name server-name
            :wait-p wait-p
            :error-p error-p)))
    (multiple-value-bind (msg ret)
        (run-program)
      (if ret
          (values msg)
          (progn
            (unless (or error-p quiet-p)
              (warn "~A" msg))
            (values nil msg))))))

(defun emacs-load (pathname &key
                              (server-name *default-emacs-server-name*)
                              (wait-p t)
                              (error-p t)
                              (ensure-server-p t))
  (emacs-eval (format nil "(load-file \"~A\")" (namestring pathname))
              :server-name server-name
              :wait-p wait-p
              :error-p error-p
              :ensure-server-p ensure-server-p))

(defun emacs-open-p (&key
                       (server-name *default-emacs-server-name*)
                       (retries 1)
                       (sleep 0.2)
                       (error-p nil))
  (multiple-value-bind (ok-p tries)
      (do ((i 0 (+ i 1))
           (ok nil))
          ((or ok (>= i retries)) (values ok i))
        (when (and (null ok) (> i 0))
          (sleep sleep))
        (setf ok (emacs-eval "(+ 0 0)"
                             :server-name server-name
                             :wait-p t
                             :error-p nil
                             :ensure-server-p nil
                             :verify-server-p nil
                             :quiet-p t)))
    (if ok-p
        (values t tries)
        (if error-p
            (error "emacs server (name: ~A) is not running" server-name)
            (values nil tries)))))

(defun open-emacs-browser (url &key
                                 (server-name *default-emacs-server-name*)
                                 (error-p t))
  (emacs-eval (format nil "(eww ~S)" url)
              :server-name server-name
              :error-p error-p))

;;
;; Theme
;;

(defun emacs-load-theme (theme &key
                                 (server-name *default-emacs-server-name*)
                                 (error-p t))
  (emacs-eval (format nil "(load-theme '~A)" (if (symbolp theme)
                                                    (string-downcase (symbol-name theme))
                                                    theme))
              :server-name server-name
              :wait-p t
              :error-p error-p
              :ensure-server-p nil))

(defun emacs-get-themes (&key
                           (server-name *default-emacs-server-name*)
                           (error-p t))
  (flet ((my-split (string)
           (let ((delimiterp #'(lambda (x) (eql x #\Space))))
             (loop :for beg = (position-if-not delimiterp string)
                     :then (position-if-not delimiterp string :start (1+ end))
                   :for end = (and beg (position-if delimiterp string :start beg))
                   :when beg :collect (subseq string beg end)
                     :while end))))
    (let ((string-themes
            (emacs-eval "(custom-available-themes)"
                        :server-name server-name
                        :wait-p t
                        :error-p error-p
                        :ensure-server-p nil)))
      (my-split (string-right-trim ")" (string-left-trim "(" string-themes))))))

;;;
;;; slime
;;;

(defparameter *default-emacs-slime-port* 4020)

(defun get-local-emacs-file (pathname)
  (asdf:system-relative-pathname 'lilu-emacs (merge-pathnames pathname #p"src/")))

(defun open-emacs-slime (&key
                           (server-name *default-emacs-server-name*)
                           (theme *default-emacs-theme*)
                           (slime-port *default-emacs-slime-port*)
                           (ensure-server-p t)
                           (create-frame-p nil)
                           (wait-p nil)
                           (error-p t))
  (declare (ignorable create-frame-p))
  (unless (if ensure-server-p
              (open-emacs :server-name server-name :theme theme :wait-p nil :error-p error-p :ignore-already-open-p t)
              (emacs-open-p :server-name server-name :error-p error-p))
    (warn "emacs server (name: ~A) is not running" server-name)
    (return-from open-emacs-slime nil))
  (if (emacs-slime-open-p :server-name server-name :error-p nil)
      (progn
        (warn (format nil "slime in emacs server (~A) is already running." server-name))
        t)
      (flet ((slime-open-fn ()
               (multiple-value-bind (output ret)
                   (let ((slime-retry-count 30)
                         (slime-sleep-interval 0.25))
                     (lilu-emacs::emacs-load (lilu-emacs::get-local-emacs-file "emacs-server.el"))
                     (emacs-eval (format nil "(lilu-slime-connect \"~A\" ~A ~A ~A ~A)"
                                         "localhost" slime-port slime-retry-count slime-sleep-interval 1)
                                 :server-name server-name
                                 :wait-p nil
                                 :error-p error-p
                                 :ensure-server-p nil
                                 :verify-server-p nil))
                 (declare (ignorable output ret))
                 (when (not output)
                   (if error-p
                       (error "slime -- connetion to swank server failed")
                       (warn  "slime -- connetion to swank server failed"))))))
        (lilu-swank:open-slime-connection server-name
                                          slime-port
                                          #'slime-open-fn)
        (when wait-p
          (lilu-swank:wait-swank-connection server-name))
        t)))

(defun emacs-slime-open-p (&key
                             (server-name *default-emacs-server-name*)
                             (error-p nil))
  (if (and
       (lilu-swank:find-swank-connection server-name :verify-p nil)
       (emacs-eval "(slime-ping)"
                  :server-name server-name
                  :wait-p t
                  :error-p nil
                  :ensure-server-p nil
                  :quiet-p t))
      t
      (if error-p
          (error "slime is not running in the emacs server (name: ~A)" server-name)
          nil)))

;;;
;;; debug
;;;

(defun call-emacs-debugger (server-name theme slime-port
                            condition me-or-my-encapsulation)
  (open-emacs-slime :server-name server-name
                    :theme theme
                    :slime-port slime-port
                    :wait-p nil
                    :error-p t
                    :ensure-server-p t)
  (lilu-swank:call-slime-debugger server-name
                                  condition
                                  me-or-my-encapsulation))
(defun make-emacs-debugger-hook (&key (server-name lilu-emacs:*default-emacs-server-name*)
                                   (theme lilu-emacs:*default-emacs-theme*)
                                   (slime-port lilu-emacs:*default-emacs-slime-port*))
  (lilu-debugger::make-standard-hook (:emacs condition me-or-my-encapsulation)
    (call-emacs-debugger server-name theme slime-port
                         condition me-or-my-encapsulation)))

(defvar *emacs-debugger-hook* (make-emacs-debugger-hook))

;;;
;;; applications
;;;

(defmethod lilu-app:run-open-terminal ((app emacs-application) &key cmd error-p wait-p)
  (if cmd
      (emacs-eval (format nil "(eshell-command ~S)" cmd)
                  :wait-p wait-p :error-p error-p)
      (emacs-eval "(eshell)" :wait-p wait-p :error-p error-p)))

(defmethod lilu-app:run-open-browser ((app emacs-application) &key url error-p wait-p)
   (if url
       (emacs-eval (format nil "(eww ~S)" url)
                   :wait-p wait-p :error-p error-p)
       (emacs-eval "(eww \"notabug.org\")"
                   :wait-p wait-p :error-p error-p)))

(defmethod lilu-app:run-open-repl ((application emacs-application) &key error-p wait-p)
  (open-emacs-slime :wait-p wait-p :error-p error-p))

(defmethod lilu-app:run-open-editor ((application emacs-application) &key file nline error-p wait-p)
  (if file
      (emacs-edit file :line-no nline :error-p error-p :wait-p wait-p :wait-closed-p wait-p)
      (open-emacs :error-p error-p :wait-p wait-p)))

(defmethod lilu-app:get-debugger-hook ((application emacs-application))
  *emacs-debugger-hook*)

(defmethod lilu-app:run-open-inspector ((application emacs-application) object &key error-p wait-p)
  (declare (ignore wait-p))
  (open-emacs-slime :ensure-server-p t :wait-p nil :error-p error-p)
  (lilu-swank:with-swank-connection (con *default-emacs-server-name*)
    (swank:inspect-in-emacs object)))
